home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / tests / filescan.test < prev    next >
Encoding:
Text File  |  1993-10-26  |  7.7 KB  |  296 lines  |  [TEXT/MPS ]
  1. #
  2. # filescan.test
  3. #
  4. # Tests for the scancontext and scanfile commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: filescan.test,v 2.4 1993/08/03 06:13:44 markd Exp $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. # Increment a name.  This takes a name and "adds one" to it, that is advancing
  22. # each digit lexically through "0"..."9" -> "A"-"Z" -> "a"..."z".  When one
  23. # digit wraps, the next one is advanced.  Optional arg forces upper case only
  24. # if true and start with all upper case or digits.
  25.  
  26. proc IncrName {Name args} {
  27.     set Upper [expr {([llength $args] == 1) && [lindex $args 0]}]
  28.     set Last  [expr [clength $Name]-1]
  29.     set Begin [csubstr $Name 0 $Last]
  30.     set Digit [cindex $Name $Last]
  31.     set Recurse 0
  32.     case $Digit in {
  33.         {9}     {set Digit A}
  34.         {Z}     {if {$Upper} {set Recurse 1} else {set Digit a}}
  35.         {z}     {set Recurse 1}
  36.         default {set Digit [ctype char [expr [ctype ord $Digit]+1]]}
  37.     }
  38.     if {$Recurse} {
  39.         if {$Last == 0} then {
  40.             return 0 ;# Wrap around
  41.         } else {
  42.             return "[IncrName $Begin]0"
  43.         }
  44.     }
  45.     return "$Begin$Digit"
  46. }
  47.  
  48. # Proc to generate record that can be validated.  The record has 
  49. # grows quite large to test the dynamic buffering in the file I/O.
  50.  
  51. proc GenScanRec {Key LineNum} {
  52.   set extra [replicate :@@@@@@@@: $LineNum]
  53.   return  "$Key This is a test record ($extra) index is $Key"
  54. }
  55.  
  56. # Proc to validate a matched record.
  57.  
  58. proc ValMatch {scanInfo errId} {
  59.     global testFH matchInfo
  60.  
  61.     Test filescan-${errId}.1 {filescan tests} {
  62.          set matchInfo(line)
  63.     } 0 [GenScanRec [lindex $scanInfo 0] [lindex $scanInfo 2]]
  64.  
  65.     Test filescan-${errId}.2 {filescan tests} {
  66.          set matchInfo(offset)
  67.     } 0 [lindex $scanInfo 1]
  68.  
  69.     Test filescan-${errId}.3 {filescan tests} {
  70.          set matchInfo(linenum)
  71.     } 0 [lindex $scanInfo 2]
  72.  
  73.     Test filescan-${errId}.4 {filescan tests} {
  74.          set matchInfo(handle)
  75.     } 0 $testFH
  76.  
  77.     set matchType [lindex $scanInfo 3] 
  78.     global matchCnt.$matchType
  79.     incr matchCnt.$matchType
  80. }
  81.  
  82. global matchInfo
  83. global matchCnt.0    matchCnt.1    matchCnt.2    matchCnt.3    DefaultCnt 
  84. global chkMatchCnt.0 chkMatchCnt.1 chkMatchCnt.2 chkMatchCnt.3 chkDefaultCnt
  85. global testFH
  86.  
  87. set matchCnt.0      0
  88. set matchCnt.1      0
  89. set matchCnt.2      0
  90. set matchCnt.3      0
  91. set defaultCnt      0
  92. set chkMatchCnt.0   0
  93. set chkMatchCnt.1   0
  94. set chkMatchCnt.2   0
  95. set chkMatchCnt.3   0
  96. set chkDefaultCnt   0
  97. set scanList       {}
  98. set maxRec        200
  99.  
  100. catch {unlink TEST.TMP}
  101. set testFH [open TEST.TMP w]
  102.  
  103. # Build a test file and a list of records to scan for.  Each element in the 
  104. # list will have the following info:
  105. #   {key fileOffset fileLineNumber matchType}
  106.  
  107. set key FatHeadAAAA
  108. for {set cnt 0} {$cnt < $maxRec} {incr cnt} {
  109.     if {($cnt % 10) == 0} {
  110.         set matchType [random 4]
  111.         incr chkMatchCnt.$matchType
  112.         set scanInfo [list "$key [tell $testFH] [expr $cnt+1] $matchType"]
  113.         if {[random 2]} {
  114.             set scanList [concat $scanList $scanInfo]
  115.         } else {
  116.             set scanList [concat $scanInfo $scanList]}
  117.     } else {
  118.         incr chkDefaultCnt}
  119.     if {$cnt == [expr $maxRec/2]} {
  120.         set midKey $key
  121.         }
  122.     puts $testFH [GenScanRec $key [expr $cnt+1]]
  123.     set key [IncrName $key 1]  ;# Upper case only
  124. }
  125.  
  126. close $testFH
  127.  
  128. # Build up the scan context.
  129.  
  130. set testCH [scancontext create]
  131.  
  132. foreach scanInfo $scanList {
  133.     set key [lindex $scanInfo 0]
  134.     set matchType [lindex $scanInfo 3]
  135.     set cmd "global matchInfo; ValMatch \{$scanInfo\} 1.1" 
  136.     case $matchType in {
  137.       {0} {scanmatch -nocase $testCH [string toupper $key] $cmd}
  138.       {1} {scanmatch $testCH ^$key  $cmd}
  139.       {2} {scanmatch $testCH $key\$ $cmd}
  140.       {3} {scanmatch $testCH $key   $cmd}
  141.     }
  142. }
  143.  
  144. scanmatch $testCH {
  145.     global defaultCnt testFH matchInfo
  146.  
  147.     incr defaultCnt
  148.  
  149.     Test filescan-1.2 {filescan tests} {
  150.         set matchInfo(handle)
  151.     } 0 $testFH
  152. }
  153.  
  154. set testFH [open TEST.TMP r]
  155. scanfile $testCH $testFH
  156.  
  157. Test filescan-1.3 {filescan tests} {
  158.     set {matchCnt.0}
  159. } 0 ${chkMatchCnt.0}
  160.  
  161. Test filescan-1.4 {filescan tests} {
  162.     set {matchCnt.1}
  163. } 0 ${chkMatchCnt.1}
  164.  
  165. Test filescan-1.5 {filescan tests} {
  166.     set {matchCnt.2}
  167. } 0 ${chkMatchCnt.2}
  168.  
  169. Test filescan-1.6 {filescan tests} {
  170.    set {matchCnt.3}
  171. } 0 ${chkMatchCnt.3}
  172.  
  173. Test filescan-1.7 {filescan tests} {
  174.     set defaultCnt
  175. } 0 $chkDefaultCnt
  176.  
  177. scancontext delete $testCH
  178.  
  179. # Test return and continue from within match commands
  180.  
  181. set testCH [scancontext create]
  182. seek $testFH 0
  183. global matchCnt
  184. set matchCnt 0
  185.  
  186. scanmatch $testCH $midKey {
  187.     global matchCnt
  188.     incr matchCnt
  189.     continue;
  190. }
  191.  
  192. scanmatch $testCH ^$midKey {
  193.     error "This should not ever get executed  2.1"
  194. }
  195.  
  196. scanmatch $testCH [IncrName $midKey] {
  197.     return "FudPucker"
  198. }
  199.  
  200. Test filescan-2.2 {filescan tests} {
  201.     scanfile $testCH $testFH
  202. } 0 "FudPucker"
  203.  
  204. scancontext delete $testCH
  205.  
  206. # Test argument checking and error handling.
  207.  
  208. Test filescan-3.1 {filescan tests} {
  209.     scancontext foomuch
  210. } 1 {invalid argument, expected one of: create or delete}
  211.  
  212. Test filescan-3.2 {filescan tests} {
  213.     scanmatch $testCH
  214. } 1 {wrong # args: scanmatch ?-nocase? contexthandle ?regexp? command}
  215.  
  216. Test filescan-3.3 {filescan tests} {
  217.     scanmatch
  218. } 1 {wrong # args: scanmatch ?-nocase? contexthandle ?regexp? command}
  219.  
  220. Test filescan-3.4 {filescan tests} {
  221.     scanfile
  222. } 1 {wrong # args: scanfile contexthandle filehandle}
  223.  
  224. Test filescan-3.5 {filescan tests} {
  225.     set testCH [scancontext create]
  226.     scanfile $testCH $testFH
  227. } 1 {no patterns in current scan context}
  228. catch {scancontext delete $testCH}
  229.  
  230. close $testFH
  231.  
  232. # 
  233. # Test subMatch handling.
  234. #
  235.  
  236. set testFH [open TEST.TMP w]
  237. loop idx 0 10 {
  238.     puts $testFH "AAx[replicate xx $idx]xBBc[replicate cc $idx]cDD"
  239. }
  240. close $testFH
  241.  
  242. # Procedure to verify submatches.  Works for upper or lower case.
  243.  
  244. proc ChkSubMatch {id matchInfoVar} {
  245.     upvar $matchInfoVar matchInfo
  246.  
  247.     set idx [expr $matchInfo(linenum) - 1]
  248.  
  249.     set end0 [expr 3+($idx * 2)]
  250.     Test filescan-$id.0.$idx {filescan tests} {
  251.         set matchInfo(submatch0)
  252.     } 0 "x[replicate xx $idx]x"
  253.     Test filescan-$id.1.$idx {filescan tests} {
  254.         set matchInfo(subindex0)
  255.     } 0 "2 $end0"
  256.  
  257.     set start1 [expr $end0+3]
  258.     set end1 [expr $start1+($idx*2)+1]
  259.     Test filescan-$id.2.$idx {filescan tests} {
  260.         set matchInfo(submatch1)
  261.     } 0 "c[replicate cc $idx]c"
  262.     Test filescan-$id.3.$idx {filescan tests} {
  263.         set matchInfo(subindex1)
  264.     } 0 "$start1 $end1"
  265.  
  266.     Test filescan-$id.4.$idx {filescan tests} {
  267.         list [info exists matchInfo(submatch2)] \
  268.              [info exists matchInfo(subindex2)]
  269.     } 0 {0 0}
  270. }
  271.  
  272. set testFH [open TEST.TMP r]
  273.  
  274. set testCH [scancontext create]
  275. scanmatch $testCH {\A*(x*)B*(c*)DD} {
  276.     ChkSubMatch 4 matchInfo
  277. }
  278.  
  279. scanmatch -nocase $testCH {\Aa(x*)B(C*)Dd} {
  280.     ChkSubMatch 5 matchInfo
  281. }
  282.  
  283. scanfile $testCH $testFH
  284.  
  285. close $testFH
  286. unlink TEST.TMP
  287.  
  288. rename GenScanRec {}
  289. rename ValMatch {}
  290. rename ChkSubMatch {}
  291.  
  292. unset matchCnt matchInfo
  293. unset matchCnt.0    matchCnt.1    matchCnt.2    matchCnt.3    defaultCnt 
  294. unset chkMatchCnt.0 chkMatchCnt.1 chkMatchCnt.2 chkMatchCnt.3 chkDefaultCnt
  295. unset testFH
  296.